home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / share / defoma / scripts / pango.defoma < prev    next >
Encoding:
Text File  |  2007-04-10  |  8.5 KB  |  343 lines
  1. @ACCEPT_CATEGORIES = qw(xfont);
  2.  
  3. package pango;
  4.  
  5. use strict;
  6. use POSIX;
  7. use Debian::Defoma::Common;
  8. use Debian::Defoma::Font;
  9. use Debian::Defoma::Id;
  10. use vars qw($ROOTDIR %UNSUPPORTED_XLFD);
  11.  
  12. import Debian::Defoma::Common;
  13. import Debian::Defoma::Font;
  14. import Debian::Defoma::Id;
  15.  
  16. my @Families = qw(sans serif monospace);
  17. my @Encodings = qw(iso8859_X iso10646 other);
  18.  
  19. my %Ids;
  20. my $PkgDir = $ROOTDIR . '/pango.d';
  21. my $PangoAlias = $PkgDir . '/pangox.aliases';
  22. my $PangoAliases = '/etc/pango/pangox.aliases';
  23. my $ConfFile = '/etc/defoma/config/pango.conf';
  24. my $term = 0;
  25. my $init = 0;
  26.  
  27. ## This function generates each element of XLFD from hashed hints, and
  28. ## returns in a hashed XLFD.
  29.  
  30. sub get_xlfd_element {
  31.     my @xlfd = split (/-/, shift);
  32.     my $ret = {};
  33.  
  34.     $ret->{Foundry} = $xlfd[1];
  35.     $ret->{Family} = $xlfd[2];
  36.     $ret->{Weight} = $xlfd[3];
  37.     $ret->{Slant} = $xlfd[4];
  38.     $ret->{SetWidth} = $xlfd[5];
  39.     $ret->{Style} = $xlfd[6];
  40.     $ret->{Pixel} = $xlfd[7];
  41.     $ret->{Point} = $xlfd[8];
  42.     $ret->{ResX} = $xlfd[9];
  43.     $ret->{ResY} = $xlfd[10];
  44.     $ret->{Spacing} = $xlfd[11];
  45.     $ret->{AvgWidth} = $xlfd[12];
  46.     $ret->{Encoding} = "$xlfd[13]-$xlfd[14]";
  47.  
  48.     return $ret;
  49. }
  50.  
  51. ## Returns a string XLFD from hashed XLFD.
  52. sub generate_xlfd {
  53.     my $xe = shift;
  54.     my $enc = $xe->{Encoding};
  55.  
  56.     $enc = '*-*' if ($xe->{Encoding} =~ /iso8859-[0-9]+/);
  57.     return join ('-', '', $xe->{Foundry}, $xe->{Family}, $xe->{Weight},
  58.              $xe->{Slant}, $xe->{SetWidth}, $xe->{Style}, '*', '*',
  59.              '*', '*', '*', '*', $enc);
  60. }
  61.  
  62. # store XLFD
  63. sub store_xlfd {
  64.     my $Id = shift;
  65.     my @cache = defoma_id_grep_cache ($Id, 'installed', sorttype => 'p');
  66.     my @nnnn_xlfd = ();
  67.     my @innn_xlfd = ();
  68.     my @nnbn_xlfd = ();
  69.     my @inbn_xlfd = ();
  70.     my $xe;
  71.     my $xlfd;
  72.  
  73.     foreach my $i (@cache) {
  74.         my $font = $Id->{1}->[$i];
  75.         $font =~ s/_/ /g;
  76.         $xe = get_xlfd_element ($font);
  77.         my $enc = "$xe->{Foundry}-$xe->{Family}-$xe->{Encoding}";
  78.         $xlfd = generate_xlfd ($xe);
  79.  
  80.         if ($xe->{Weight} =~ /bold/ && ($xe->{Slant} eq 'o' || $xe->{Slant} eq 'i')) {
  81.             push (@inbn_xlfd, $xlfd) if (!grep (/\Q$enc/, @inbn_xlfd));
  82.             next;
  83.         }
  84.         if ($xe->{Weight} !~ /bold/ && ($xe->{Slant} eq 'o' || $xe->{Slant} eq 'i')) {
  85.             push (@innn_xlfd, $xlfd) if (!grep (/\Q$enc/, @innn_xlfd));
  86.             next;
  87.         }
  88.         if ($xe->{Weight} =~ /bold/ && $xe->{Slant} =~ /r/) {
  89.             push (@nnbn_xlfd, $xlfd) if (!grep (/\Q$enc/, @nnbn_xlfd));
  90.             next;
  91.         }
  92.         push (@nnnn_xlfd, $xlfd) if (!grep (/\Q$enc/, @nnnn_xlfd));
  93.     }
  94.     return \(@nnnn_xlfd, @innn_xlfd, @nnbn_xlfd, @inbn_xlfd);
  95. }
  96.  
  97. # write section
  98. sub write_section {
  99.     my $file = shift;
  100.     my $family = shift;
  101.  
  102.     my @nnnn_iso8859_X = ();
  103.     my @innn_iso8859_X = ();
  104.     my @nnbn_iso8859_X = ();
  105.     my @inbn_iso8859_X = ();
  106.     my @nnnn_iso10646 = ();
  107.     my @innn_iso10646 = ();
  108.     my @nnbn_iso10646 = ();
  109.     my @inbn_iso10646 = ();
  110.     my @nnnn_other = ();
  111.     my @innn_other = ();
  112.     my @nnbn_other = ();
  113.     my @inbn_other = ();
  114.     my $id_iso8859_X = $family . '_iso8859_X';
  115.     my $id_iso10646 = $family . '_iso10646';
  116.     my $id_other = $family . '_other';
  117.     my $hash;
  118.     my ($nnnn, $innn, $nnbn, $inbn);
  119.  
  120.     open (F, ">> $file");
  121.     ($nnnn, $innn, $nnbn, $inbn) = store_xlfd ($Ids{$id_other});
  122.     @nnnn_other = @{$nnnn};
  123.     @innn_other = @{$innn};
  124.     @nnbn_other = @{$nnbn};
  125.     @inbn_other = @{$inbn};
  126.     ($nnnn, $innn, $nnbn, $inbn) = store_xlfd ($Ids{$id_iso10646});
  127.     @nnnn_iso10646 = @{$nnnn};
  128.     @innn_iso10646 = @{$innn};
  129.     @nnbn_iso10646 = @{$nnbn};
  130.     @inbn_iso10646 = @{$inbn};
  131.     ($nnnn, $innn, $nnbn, $inbn) = store_xlfd ($Ids{$id_iso8859_X});
  132.     @nnnn_iso8859_X = @{$nnnn};
  133.     @innn_iso8859_X = @{$innn};
  134.     @nnbn_iso8859_X = @{$nnbn};
  135.     @inbn_iso8859_X = @{$inbn};
  136.  
  137.     print F "$family normal normal normal normal \\\n\t\"";
  138.     if (scalar (@nnnn_other) > 0) {
  139.         print F join (",\\\n\t", @nnnn_other);
  140.         print F ",\\\n\t";
  141.     }
  142.     if (scalar (@nnnn_iso10646) > 0) {
  143.         print F join (",\\\n\t", @nnnn_iso10646);
  144.         print F ",\\\n\t";
  145.     }
  146.     if (exists ($UNSUPPORTED_XLFD {"$family-normal-normal-normal-normal"})) {
  147.         print F $UNSUPPORTED_XLFD {"$family-normal-normal-normal-normal"};
  148.         print F ",\\\n\t";
  149.     }
  150.     if (scalar (@nnnn_iso8859_X) > 0) {
  151.         print F join (",\\\n\t", @nnnn_iso8859_X);
  152.         print F ",\\\n\t";
  153.     }
  154.     print F "-*-fixed-medium-r-normal--*-*-*-*-*-*-*-*\"\n\n";
  155.  
  156.     print F "$family italic normal normal normal \\\n\t\"";
  157.     if (scalar (@innn_other) > 0) {
  158.         print F join (",\\\n\t", @innn_other);
  159.         print F ",\\\n\t";
  160.     }
  161.     if (scalar (@innn_iso10646) > 0) {
  162.         print F join (",\\\n\t", @innn_iso10646);
  163.         print F ",\\\n\t";
  164.     }
  165.     if (exists ($UNSUPPORTED_XLFD {"$family-italic-normal-normal-normal"})) {
  166.         print F $UNSUPPORTED_XLFD {"$family-italic-normal-normal-normal"};
  167.         print F ",\\\n\t";
  168.     }
  169.     if (scalar (@innn_iso8859_X) > 0) {
  170.         print F join (",\\\n\t", @innn_iso8859_X);
  171.         print F ",\\\n\t";
  172.     }
  173.     print F "-*-fixed-medium-i-normal--*-*-*-*-*-*-*-*\"\n\n";
  174.  
  175.     print F "$family normal normal bold normal \\\n\t\"";
  176.     if (scalar (@nnbn_other) > 0) {
  177.         print F join (",\\\n\t", @nnbn_other);
  178.         print F ",\\\n\t";
  179.     }
  180.     if (scalar (@nnbn_iso10646) > 0) {
  181.         print F join (",\\\n\t", @nnbn_iso10646);
  182.         print F ",\\\n\t";
  183.     }
  184.     if (exists ($UNSUPPORTED_XLFD {"$family-normal-normal-bold-normal"})) {
  185.         print F $UNSUPPORTED_XLFD {"$family-normal-normal-bold-normal"};
  186.         print F ",\\\n\t";
  187.     }
  188.     if (scalar (@nnbn_iso8859_X) > 0) {
  189.         print F join (",\\\n\t", @nnbn_iso8859_X);
  190.         print F ",\\\n\t";
  191.     }
  192.     print F "-*-fixed-bold-r-normal--*-*-*-*-*-*-*-*\"\n\n";
  193.  
  194.     print F "$family italic normal bold normal \\\n\t\"";
  195.     if (scalar (@inbn_other) > 0) {
  196.         print F join (",\\\n\t", @inbn_other);
  197.         print F ",\\\n\t";
  198.     }
  199.     if (scalar (@inbn_iso10646) > 0) {
  200.         print F join (",\\\n\t", @inbn_iso10646);
  201.         print F ",\\\n\t";
  202.     }
  203.     if (exists ($UNSUPPORTED_XLFD {"$family-italic-normal-bold-normal"})) {
  204.         print F $UNSUPPORTED_XLFD {"$family-italic-normal-bold-normal"};
  205.         print F ",\\\n\t";
  206.     }
  207.     if (scalar (@inbn_iso8859_X) > 0) {
  208.         print F join (",\\\n\t", @inbn_iso8859_X);
  209.         print F ",\\\n\t";
  210.     }
  211.     print F "-*-fixed-bold-i-normal--*-*-*-*-*-*-*-*\"\n\n";
  212.     close F;
  213. }
  214.  
  215. sub do_init {
  216.     return if ($init);
  217.  
  218.     $init = 1;
  219.     foreach my $i (@Families) {
  220.         foreach my $j (@Encodings) {
  221.             my $id = $i . '_' . $j;
  222.             $Ids{$id} = defoma_id_open_cache ($id);
  223.         }
  224.     }
  225.     if ( -f $ConfFile ) {
  226.         do "$ConfFile" or die ("$@\n");
  227.     }
  228.     return 0;
  229. }
  230.  
  231. sub do_term {
  232.     unless ($term) {
  233.         $term = 1;
  234.  
  235.         my $xe;
  236.         my $xlfd;
  237.  
  238.         open (F, "> $PangoAlias.bak") or die "$PangoAlias.bak: $!";
  239.         print F "## THIS FILE IS GENERATED BY DEFOMA, DO NOT EDIT\n\n";
  240.         close F;
  241.  
  242.         ## Sans
  243.         write_section ("$PangoAlias.bak", "sans");
  244.  
  245.         ## Serif
  246.         write_section ("$PangoAlias.bak", "serif");
  247.  
  248.         ## Monospace
  249.         write_section ("$PangoAlias.bak", "monospace");
  250.  
  251.         rename ("$PangoAlias.bak", "$PangoAlias");
  252.         foreach my $i (@Families) {
  253.             foreach my $j (@Encodings) {
  254.                 my $id = $i . '_' . $j;
  255.                 defoma_id_close_cache ($Ids{$id});
  256.                 $Ids{$id} = undef;
  257.             }
  258.         }
  259.     }
  260.     return 0;
  261. }
  262.  
  263. sub actual_register {
  264.     my ($font, $h, $cache) = @_;
  265.     my $id_iso8859_X;
  266.     my $id_iso10646;
  267.     my $id_other;
  268.     my $xe;
  269.  
  270.     $id_iso8859_X = $cache . "_iso8859_X";
  271.     $id_iso10646 = $cache . "_iso10646";
  272.     $id_other = $cache . "_other";
  273.     $xe = get_xlfd_element ($font);
  274.     if ($xe->{Encoding} =~ /iso8859-[0-9]+/) {
  275.         defoma_id_register ($Ids{$id_iso8859_X},
  276.                     type => 'real',
  277.                     font => $font,
  278.                     id => $font,
  279.                     priority => $h->{Priority});
  280.     } elsif ($xe->{Encoding} =~ /iso10646/) {
  281.         defoma_id_register ($Ids{$id_iso10646},
  282.                     type => 'real',
  283.                     font => $font,
  284.                     id => $font,
  285.                     priority => $h->{Priority});
  286.     } else {
  287.         defoma_id_register ($Ids{$id_other},
  288.                     type => 'real',
  289.                     font => $font,
  290.                     id => $font,
  291.                     priority => $h->{Priority});
  292.     }
  293. }
  294.  
  295. sub do_register {
  296.     my $font = shift;
  297.     my @hints = defoma_font_get_hints ('xfont', $font);
  298.     my $h = parse_hints_start ('', @hints);
  299.     my $cache = "monospace";
  300.     my $registered = 0;
  301.  
  302.     if (exists ($h->{'Shape'}) && $h->{'Shape'} =~ /\bNoSerif\b/) {
  303.         $cache = "sans";
  304.         actual_register ($font, $h, $cache);
  305.         $registered = 1;
  306.     }
  307.     if (exists ($h->{'Shape'}) && $h->{'Shape'} =~ /\bSerif\b/) {
  308.         $cache = "serif";
  309.         actual_register ($font, $h, $cache);
  310.         $registered = 1;
  311.     }
  312.     if ((exists ($h->{'Width'}) && $h->{'Width'} =~ /\bFixed\b/) || !$registered) {
  313.         $cache = "monospace";
  314.         actual_register ($font, $h, $cache);
  315.     }
  316.     
  317.     return 0;
  318. }
  319.  
  320. sub do_unregister {
  321.     my $font = shift;
  322.  
  323.     foreach my $i (@Families) {
  324.         foreach my $j (@Encodings) {
  325.             my $id = $i . '_' . $j;
  326.             defoma_id_unregister ($Ids{$id}, type => 'real', font => $font);
  327.         }
  328.     }
  329. }
  330.  
  331. sub xfont {
  332.     my $arg = shift;
  333.  
  334.     if ($arg eq 'init') { return do_init (); }
  335.     elsif ($arg eq 'term') { return do_term (); }
  336.     elsif ($arg eq 'register') { return do_register (@_); }
  337.     elsif ($arg eq 'unregister') { return do_unregister (@_); }
  338.     return 0;
  339. }
  340.  
  341. 1;
  342.  
  343.